rm(list = ls())
library(tidyverse)Entrega Estadística Descriptiva y Regresión Lineal
Instrucciones (leer antes de empezar)
Deberías estar abriendo este
.qmddentro de un proyecto enR Studio.Modifica en el documento
.qmdtus datos personales (nombre e ID) situados en la cabecera del archivo. No toques nada más en la cabecera (ten en cuenta que he incluidoembed-resources: truepara que todo quede contenido en un único html sin archivos extra, ytheme: [style.scss]para darle un estilo cuco a la entrega con el archivostyle.scssen la carpeta).Asegúrese, ANTES de seguir editando el documento, de que el archivo
.qmdse renderiza correctamente y se genera el correspondiente.htmlen la carpeta local de su ordenador. Los chunks (cajas de código) creados están vacíos o incompletos, de ahí que la mayoría de ellos tengan la opción#| eval: false. Una vez que edites lo que consideres, debes cambiar cada chunck a#| eval: true(o quitarla directamente) para ejecutarlos.Recuerda que puedes ejecutar chunk a chunk con el botón play o ejecutar todos los chunks hasta un chunk determinado (con el botón a la izquierda del anterior)
Sólo se evaluará el archivo
.htmlgenerado.
Paquetes requiridos
Carga a continuación los paquetes que vayas a necesitar:
Ejercicio ___: creación tema gráficos
Crea un estilo personalizado para todos los gráficos de la práctica.
Para establecer un tema para todos los gráficos dentro de un mismo quarto hacemos uso de la función theme_set(). Si más tarde queremos modificarlo podríamos hacerlo con la función theme_update() ambas funciones pertenecen al paquete ggplot2.
Podemos elegir el tipo de letra que usan los gráficos. Para ver las fuentes disponibles puedes visitar https://fonts.google.com/. Para poder usar diferentes fuentes deberemos instalar los paquetes sysfonts y showtext. Con la función font_add_google() le indicaremos la tipografía y con showtext_auto() nos permite su uso.
Un ejemplo sencillo podría ser el siguiente:
library(showtext)
library(sysfonts)
font_add_google(name = "Lora")
showtext_auto()
theme_set(theme_minimal(base_family = "Lora"))
# Configurar tema
theme_update(
plot.title = element_text(color = "#C34539", face = "bold", size = 33),
plot.subtitle = element_text(color = "#3E6FCB", face = "bold", size = 21),
axis.title.x = element_text(size = 19),
axis.title.y = element_text(size = 19))Ejercicio ___: descripción de la base de datos
Lee el conjunto de datos colesterol. A continuación utiliza el código que estimes necesario para responder a las siguientes preguntas:
¿Cuántas variables hay en el conjunto de datos? ¿Y observaciones?
¿Qué variables tienen valores missing?
De qué tipo son las variables que se presentan en el conjunto de datos.
Las variables cualitativas diferencialas en nominales y ordinales y las cuantitativas en discretas finitas, discretas infinitas y continuas.
Ejercicio ___: variables cualitativas
Responde a las siguientes cuestiones sobre las variables cualitativas
Cuáles y cuántas son las modalidades de cada variable.
Calcula las tablas de frecuencias para las variable y determina el valor de la moda
colesterol <- read_csv(file = "./colesterol.csv")
colesterol |> pull(nivel_actividad) |> table()
Alta Baja Moderada
21 39 75
colesterol |> pull(consumo_grasas) |> table()
Alto Bajo Moderado
24 37 75
colesterol |> pull(tabaquismo) |> table()
No Sí
100 35
colesterol |> pull(sexo) |> table()
Hombre Mujer
75 72
colesterol |> pull(antecedentes) |> table()
No Sí
109 27
Ejercicio ___: creación nueva variable
Crea una nueva variable que represente el IMC, llámala ´imc´.
\[IMC = \frac{peso(kg)}{estatura^2(m)}\]
colesterol <-
colesterol |>
mutate(imc = peso/estatura^2)Ejercicio ___: variables cuantitativas
Calcula para las variables numéricas la media, desviación típica, mediana y coeficiente de variación (incluyendo la variable IMC). Sin realizar ningún gráfico, ¿consideras que las variables numéricas son simétricas? ¿Crees que la media es una medida representativa para todas las variables? Justifica tu respuesta.
El coeficiente de variación no está definido en una función de R pero se calcula como \(CV = \frac{\sigma}{\bar x}\).
Se puede interpretar como el grado de variabilidad de una variable de forma relativa, es decir, independiente de la escala de la variable. Cuanto menor sea más homogéneos podremos decir que son los valores de la variable y por lo tanto, se podrá considerar que la media es un valor representativo de dicha variable. Por lo general se suele asumir que con valores superiores a 0.3 los valores de la variable son heterogéneos.
resumen <-
colesterol |>
summarise(medias = across(where(is.numeric), mean, na.rm = TRUE),
sd = across(where(is.numeric), sd, na.rm = TRUE),
mediana = across(where(is.numeric), median, na.rm = TRUE),
cv = sd/medias) Warning: There was 1 warning in `summarise()`.
ℹ In argument: `medias = across(where(is.numeric), mean, na.rm = TRUE)`.
Caused by warning:
! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
Supply arguments directly to `.fns` through an anonymous function instead.
# Previously
across(a:b, mean, na.rm = TRUE)
# Now
across(a:b, \(x) mean(x, na.rm = TRUE))
resumen$medias# A tibble: 1 × 8
colesterol edad estatura peso presion_sistolica presion_diastolica glucosa
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 182. 55 1.70 76.4 114. 76.1 122.
# ℹ 1 more variable: imc <dbl>
resumen$mediana# A tibble: 1 × 8
colesterol edad estatura peso presion_sistolica presion_diastolica glucosa
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 182. 54 1.71 74.8 113. 75.6 123.
# ℹ 1 more variable: imc <dbl>
resumen$sd# A tibble: 1 × 8
colesterol edad estatura peso presion_sistolica presion_diastolica glucosa
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 44.5 18.7 0.104 15.4 17.8 13.9 17.7
# ℹ 1 more variable: imc <dbl>
resumen$cv colesterol edad estatura peso presion_sistolica
1 0.2445559 0.3407521 0.06111488 0.2012612 0.1553071
presion_diastolica glucosa imc
1 0.1827019 0.1454416 0.1476838
Ejercicio ___: gráficas
Grafica las variables que te salieron con menor y mayor coeficiente de variación en el ejercicio anterior con el tipo de gráfico que consideres más oportuno. ¿Qué ves de diferente? ¿Cuál te parece más simétrica? ¿Crees que concuerda con los resultados del apartado anterior?
colesterol |>
drop_na(estatura) |>
ggplot(aes(x = estatura)) +
geom_histogram() `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
colesterol |>
drop_na(edad) |>
ggplot(aes(x = edad)) +
geom_histogram()`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Se valorará que los gráficos sean bonitos y el tiempo dedicado a personalizarlos.
Ejercicio ___: valores ausentes 1
Elimina de todos los valores ausentes de todas las variables del conjunto de datos. ¿Qué ha pasado? ¿Cuántas observaciones tienes ahora? ¿Consideras necesario imputar los valores ausentes? En caso afirmativo imputa por el valor que consideres más apropiado (media, mediana o moda) todas las variables en las que sea necesario menos colesterol.
colesterol_imput <-
colesterol |>
mutate(edad = if_else(is.na(edad), median(edad, na.rm = TRUE), edad),
estatura = if_else(is.na(estatura),
mean(estatura, na.rm = TRUE), estatura),
antecedentes = if_else(is.na(antecedentes), "No", antecedentes),
tabaquismo = if_else(is.na(tabaquismo), "No", tabaquismo),
consumo_grasas = if_else(is.na(consumo_grasas), "Moderado", consumo_grasas),
nivel_actividad = if_else(is.na(nivel_actividad), "Moderada", nivel_actividad),
imc = peso/estatura^2)Ejercicio ___: transformación variables cualis
Transforma las variables cualitativas en tipo factor teniendo en cuenta si son nominales u ordinales.
colesterol <-
colesterol |>
mutate(nivel_actividad = factor(nivel_actividad,
ordered = TRUE,
levels = c("Baja", "Moderada", "Alta")),
consumo_grasas = factor(consumo_grasas,
ordered = TRUE,
levels = c("Bajo", "Moderado", "Alto")),
tabaquismo = factor(tabaquismo),
sexo = factor(sexo),
antecedentes = factor(antecedentes))Ejercicio ___: valores ausentes 2
Separa en dos conjuntos de datos aquellas observaciones que tengan valor missing en la variable colesterol de las que no y guardalos.
datos_modelo <-
colesterol_imput |>
filter(!is.na(colesterol))
prediccion <-
colesterol_imput |>
filter(is.na(colesterol))Ejercicio ___: cuali vs cuali
Se quiere comparar los hábitos que tienen los hombres frente a las mujeres, para ello calcula lo siguiente:
Las 3 tablas de contingencia sexo VS nivel_actividad/consumo_grasas/tabaquismo.
Las 3 tablas anteriores pero normalizadas por la variable sexo.
¿Crees que un sexo tiene peores hábitos que otro en alguna de las variables? Justifica tu respuesta con las tablas y numéricamente con un test estadístico.
En caso de que lo consideres oportuno calcula el Risk Ratio, RR. Comenta los resultados.
Elige de las 3 posibles combinaciones de los pares de variables una y realiza un gráfico de barras en el que queden representadas las dos variables.
prop.table(table(colesterol_imput$sexo, colesterol_imput$nivel_actividad))
Alta Baja Moderada
Hombre 0.06802721 0.11564626 0.32653061
Mujer 0.07482993 0.14965986 0.26530612
prop.table(table(colesterol_imput$sexo, colesterol_imput$consumo_grasas))
Alto Bajo Moderado
Hombre 0.12925170 0.11564626 0.26530612
Mujer 0.03401361 0.13605442 0.31972789
prop.table(table(colesterol_imput$sexo, colesterol_imput$tabaquismo))
No Sí
Hombre 0.3741497 0.1360544
Mujer 0.3877551 0.1020408
prop.table(table(colesterol_imput$sexo, colesterol_imput$nivel_actividad), margin = 1)
Alta Baja Moderada
Hombre 0.1333333 0.2266667 0.6400000
Mujer 0.1527778 0.3055556 0.5416667
prop.table(table(colesterol_imput$sexo, colesterol_imput$consumo_grasas), margin = 1)
Alto Bajo Moderado
Hombre 0.25333333 0.22666667 0.52000000
Mujer 0.06944444 0.27777778 0.65277778
prop.table(table(colesterol_imput$sexo, colesterol_imput$tabaquismo), margin = 1)
No Sí
Hombre 0.7333333 0.2666667
Mujer 0.7916667 0.2083333
chisq.test(colesterol_imput$sexo, colesterol_imput$nivel_actividad)
Pearson's Chi-squared test
data: colesterol_imput$sexo and colesterol_imput$nivel_actividad
X-squared = 1.5591, df = 2, p-value = 0.4586
chisq.test(colesterol_imput$sexo, colesterol_imput$consumo_grasas)
Pearson's Chi-squared test
data: colesterol_imput$sexo and colesterol_imput$consumo_grasas
X-squared = 9.0967, df = 2, p-value = 0.01058
chisq.test(colesterol_imput$sexo, colesterol_imput$tabaquismo)
Pearson's Chi-squared test with Yates' continuity correction
data: colesterol_imput$sexo and colesterol_imput$tabaquismo
X-squared = 0.40502, df = 1, p-value = 0.5245
ggplot(colesterol_imput) +
geom_bar(aes(x = sexo, fill = consumo_grasas),
position = "dodge", alpha = 0.6) +
ggthemes::scale_fill_colorblind() +
theme_minimal()Ejercicio ___: cuanti vs cuanti
Calcula la mtriz de correlaciones de las variables numéricas y visualizalo.
GGally::ggpairs(colesterol_imput |> select(where(is.numeric)))Ejercicio ___: cuanti vs cuanti
A partir del ejercicio anterior:
Observa las correlaciones de la variable IMC, sabemos que se calcula a partir de peso y altura. ¿Por qué crees que salen esos resultados en las correlaciones?
Observar las correlaciones de la variable colesterol y comenta.
Ejercicio ___: regresión lineal modelo saturado
Se quiere predecir la variable colesterol. Realiza un modelo saturado con todas las variables y calcula el ANOVA. ¿Qué conclusiones obtienes? (No hace falta que interpretes ningún parámetro).
En el ejercicio ___ separaste el conjunto de datos en 2. Haz uso del conjunto sin ausentes en la variable colesterol para generar los modelos y emplea la otra base cuando sea necesario predecir.
modelo <- lm(colesterol ~ ., data = datos_modelo)
summary(modelo)
Call:
lm(formula = colesterol ~ ., data = datos_modelo)
Residuals:
Min 1Q Median 3Q Max
-18.312 -4.069 -1.063 1.609 30.590
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -1.311e+02 7.901e+01 -1.659 0.09981 .
edad 5.566e-01 4.106e-02 13.557 < 2e-16 ***
nivel_actividadBaja 1.516e+00 2.459e+00 0.617 0.53869
nivel_actividadModerada 1.844e+00 2.268e+00 0.813 0.41787
estatura 1.878e+00 4.595e+01 0.041 0.96747
peso -8.186e-02 4.978e-01 -0.164 0.86967
consumo_grasasBajo -8.207e+00 2.453e+00 -3.346 0.00110 **
consumo_grasasModerado -4.436e+00 2.138e+00 -2.075 0.04017 *
tabaquismoSí 4.612e+00 1.766e+00 2.611 0.01018 *
sexoMujer 2.478e+00 1.499e+00 1.653 0.10097
antecedentesSí 5.931e+00 1.899e+00 3.124 0.00224 **
presion_sistolica 2.312e-02 7.578e-02 0.305 0.76080
presion_diastolica -1.151e-03 9.762e-02 -0.012 0.99061
glucosa 8.541e-04 4.191e-02 0.020 0.98377
imc 1.065e+01 1.430e+00 7.447 1.6e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 8.201 on 120 degrees of freedom
Multiple R-squared: 0.9696, Adjusted R-squared: 0.9661
F-statistic: 273.8 on 14 and 120 DF, p-value: < 2.2e-16
modelo |> aov()Call:
aov(formula = modelo)
Terms:
edad nivel_actividad estatura peso consumo_grasas
Sum of Squares 12339.55 4324.70 3214.78 232053.77 769.65
Deg. of Freedom 1 2 1 1 2
tabaquismo sexo antecedentes presion_sistolica
Sum of Squares 498.91 142.02 616.91 1.30
Deg. of Freedom 1 1 1 1
presion_diastolica glucosa imc Residuals
Sum of Squares 9.31 112.46 3730.44 8071.32
Deg. of Freedom 1 1 1 120
Residual standard error: 8.201279
Estimated effects may be unbalanced
modelo |> anova()Analysis of Variance Table
Response: colesterol
Df Sum Sq Mean Sq F value Pr(>F)
edad 1 12340 12340 183.4578 < 2.2e-16 ***
nivel_actividad 2 4325 2162 32.1487 6.603e-12 ***
estatura 1 3215 3215 47.7957 2.453e-10 ***
peso 1 232054 232054 3450.0509 < 2.2e-16 ***
consumo_grasas 2 770 385 5.7214 0.004233 **
tabaquismo 1 499 499 7.4175 0.007423 **
sexo 1 142 142 2.1114 0.148815
antecedentes 1 617 617 9.1720 0.003009 **
presion_sistolica 1 1 1 0.0193 0.889735
presion_diastolica 1 9 9 0.1384 0.710527
glucosa 1 112 112 1.6720 0.198477
imc 1 3730 3730 55.4622 1.600e-11 ***
Residuals 120 8071 67
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Ejercicio ___: regresión lineal filtrado variables
Antes de realizar la selección de variables del modelo emplea la función
check_collinearity()de la libreríaperformance. Para comprobar la colinealidad. ¿Qué variables presentan problemas de colinealidad? Justifica con cual de todas ellas crees que tendría sentido quedarse.
METER EXPLICACIÓN
performance::check_collinearity(modelo)# Check for Multicollinearity
Low Correlation
Term VIF VIF 95% CI Increased SE Tolerance
edad 1.13 [ 1.03, 1.54] 1.06 0.88
nivel_actividad 1.17 [ 1.05, 1.54] 1.08 0.85
consumo_grasas 1.33 [ 1.16, 1.69] 1.15 0.75
tabaquismo 1.03 [ 1.00, 6.99] 1.01 0.97
sexo 1.13 [ 1.03, 1.54] 1.06 0.89
antecedentes 1.06 [ 1.00, 1.99] 1.03 0.95
presion_sistolica 3.58 [ 2.82, 4.67] 1.89 0.28
presion_diastolica 3.55 [ 2.79, 4.63] 1.88 0.28
glucosa 1.12 [ 1.03, 1.55] 1.06 0.89
Tolerance 95% CI
[0.65, 0.97]
[0.65, 0.95]
[0.59, 0.87]
[0.14, 1.00]
[0.65, 0.97]
[0.50, 1.00]
[0.21, 0.35]
[0.22, 0.36]
[0.65, 0.97]
High Correlation
Term VIF VIF 95% CI Increased SE Tolerance Tolerance 95% CI
estatura 44.37 [33.21, 59.40] 6.66 0.02 [0.02, 0.03]
peso 120.07 [89.62, 160.99] 10.96 8.33e-03 [0.01, 0.01]
imc 66.52 [49.71, 89.12] 8.16 0.02 [0.01, 0.02]
# Quitar peso y estatura
modelo <- lm(colesterol ~ ., data = datos_modelo |> select(-c(peso, estatura)))
summary(modelo)
Call:
lm(formula = colesterol ~ ., data = select(datos_modelo, -c(peso,
estatura)))
Residuals:
Min 1Q Median 3Q Max
-17.263 -4.771 -1.218 1.655 30.512
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -1.264e+02 8.652e+00 -14.610 < 2e-16 ***
edad 5.525e-01 4.045e-02 13.660 < 2e-16 ***
nivel_actividadBaja 1.428e+00 2.441e+00 0.585 0.55958
nivel_actividadModerada 1.641e+00 2.237e+00 0.734 0.46454
consumo_grasasBajo -7.704e+00 2.333e+00 -3.302 0.00126 **
consumo_grasasModerado -4.135e+00 2.066e+00 -2.001 0.04758 *
tabaquismoSí 4.477e+00 1.746e+00 2.563 0.01158 *
sexoMujer 2.453e+00 1.489e+00 1.647 0.10206
antecedentesSí 5.813e+00 1.881e+00 3.090 0.00248 **
presion_sistolica 1.403e-02 7.435e-02 0.189 0.85061
presion_diastolica -3.846e-05 9.703e-02 0.000 0.99968
glucosa -6.111e-04 4.085e-02 -0.015 0.98809
imc 1.041e+01 1.897e-01 54.866 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 8.153 on 122 degrees of freedom
Multiple R-squared: 0.9695, Adjusted R-squared: 0.9665
F-statistic: 323.2 on 12 and 122 DF, p-value: < 2.2e-16
Ejercicio ___: regresión lineal filtrado variables
Utilizando la función
stepAIC()de la libreríaMASSrealiza una selección de las variables automática del modelo y plantea el modelo final.
MASS::stepAIC(modelo)Start: AIC=578.89
colesterol ~ edad + nivel_actividad + consumo_grasas + tabaquismo +
sexo + antecedentes + presion_sistolica + presion_diastolica +
glucosa + imc
Df Sum of Sq RSS AIC
- nivel_actividad 2 36 8145 575.48
- presion_diastolica 1 0 8109 576.89
- glucosa 1 0 8109 576.89
- presion_sistolica 1 2 8111 576.93
<none> 8109 578.89
- sexo 1 180 8289 579.86
- tabaquismo 1 437 8546 583.97
- consumo_grasas 2 735 8844 586.60
- antecedentes 1 635 8744 587.06
- edad 1 12403 20512 702.17
- imc 1 200088 208197 1015.03
Step: AIC=575.48
colesterol ~ edad + consumo_grasas + tabaquismo + sexo + antecedentes +
presion_sistolica + presion_diastolica + glucosa + imc
Df Sum of Sq RSS AIC
- presion_diastolica 1 0 8145 573.48
- glucosa 1 0 8145 573.49
- presion_sistolica 1 3 8148 573.54
<none> 8145 575.48
- sexo 1 166 8311 576.21
- tabaquismo 1 438 8583 580.55
- antecedentes 1 611 8756 583.25
- consumo_grasas 2 749 8894 583.36
- edad 1 12760 20905 700.73
- imc 1 201970 210115 1012.27
Step: AIC=573.48
colesterol ~ edad + consumo_grasas + tabaquismo + sexo + antecedentes +
presion_sistolica + glucosa + imc
Df Sum of Sq RSS AIC
- glucosa 1 0 8145 571.49
- presion_sistolica 1 8 8153 571.61
<none> 8145 573.48
- sexo 1 166 8311 574.21
- tabaquismo 1 439 8584 578.57
- antecedentes 1 611 8756 581.25
- consumo_grasas 2 752 8897 581.41
- edad 1 12766 20911 698.77
- imc 1 218878 227023 1020.72
Step: AIC=571.49
colesterol ~ edad + consumo_grasas + tabaquismo + sexo + antecedentes +
presion_sistolica + imc
Df Sum of Sq RSS AIC
- presion_sistolica 1 8 8154 569.63
<none> 8145 571.49
- sexo 1 166 8311 572.21
- tabaquismo 1 439 8584 576.58
- antecedentes 1 611 8756 579.26
- consumo_grasas 2 754 8899 579.43
- edad 1 12954 21099 697.98
- imc 1 224189 232334 1021.84
Step: AIC=569.63
colesterol ~ edad + consumo_grasas + tabaquismo + sexo + antecedentes +
imc
Df Sum of Sq RSS AIC
<none> 8154 569.63
- sexo 1 160 8314 570.25
- tabaquismo 1 437 8591 574.68
- antecedentes 1 603 8756 577.26
- consumo_grasas 2 750 8904 577.51
- edad 1 12979 21133 696.20
- imc 1 224309 232462 1019.91
Call:
lm(formula = colesterol ~ edad + consumo_grasas + tabaquismo +
sexo + antecedentes + imc, data = select(datos_modelo, -c(peso,
estatura)))
Coefficients:
(Intercept) edad consumo_grasasBajo
-122.8629 0.5445 -7.7549
consumo_grasasModerado tabaquismoSí sexoMujer
-4.1891 4.4729 2.2756
antecedentesSí imc
5.5986 10.4058
modelo <- lm(colesterol ~ edad + consumo_grasas + tabaquismo + antecedentes + imc, data = datos_modelo)
summary(modelo)
Call:
lm(formula = colesterol ~ edad + consumo_grasas + tabaquismo +
antecedentes + imc, data = datos_modelo)
Residuals:
Min 1Q Median 3Q Max
-16.448 -4.576 -1.082 2.076 30.842
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -122.83801 5.33816 -23.011 < 2e-16 ***
edad 0.53715 0.03823 14.049 < 2e-16 ***
consumo_grasasBajo -6.92094 2.23200 -3.101 0.00237 **
consumo_grasasModerado -3.45887 1.95135 -1.773 0.07868 .
tabaquismoSí 4.50552 1.72410 2.613 0.01004 *
antecedentesSí 5.59469 1.83756 3.045 0.00283 **
imc 10.43834 0.17586 59.358 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 8.059 on 128 degrees of freedom
Multiple R-squared: 0.9687, Adjusted R-squared: 0.9673
F-statistic: 660.9 on 6 and 128 DF, p-value: < 2.2e-16
Ejercicio ___: regresión lineal filtrado variables
Explica por qué se eliminan variables del modelo cuando estas no son significativas. ¿Qué contraste se plantea?
Ejercicio ___: regresión lineal diagnosis modelo
Realiza la diagnosis del modelo en tu modelo final.
# Falla normalidad
performance::check_model(modelo)performance::check_heteroscedasticity(modelo)Warning: Heteroscedasticity (non-constant error variance) detected (p = 0.025).
olsrr::ols_test_normality(modelo)-----------------------------------------------
Test Statistic pvalue
-----------------------------------------------
Shapiro-Wilk 0.9081 0.0000
Kolmogorov-Smirnov 0.1517 0.0040
Cramer-von Mises 12.7561 0.0000
Anderson-Darling 3.6729 0.0000
-----------------------------------------------
performance::check_autocorrelation(modelo)OK: Residuals appear to be independent and not autocorrelated (p = 0.574).
linealidad <- lm(data = tibble("fitted" = modelo$fitted.values,
"residuals" = modelo$residuals),
formula = residuals ~ fitted + I(fitted^2))
linealidad |> summary()
Call:
lm(formula = residuals ~ fitted + I(fitted^2), data = tibble(fitted = modelo$fitted.values,
residuals = modelo$residuals))
Residuals:
Min 1Q Median 3Q Max
-20.297 -3.918 -0.642 2.713 30.615
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 51.801928 7.755954 6.679 6.10e-10 ***
fitted -0.602391 0.086427 -6.970 1.37e-10 ***
I(fitted^2) 0.001651 0.000234 7.054 8.80e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 6.763 on 132 degrees of freedom
Multiple R-squared: 0.2738, Adjusted R-squared: 0.2628
F-statistic: 24.88 on 2 and 132 DF, p-value: 6.769e-10
linealidad <- lm(data = tibble("fitted" = modelo$fitted.values,
"residuals" = modelo$residuals),
formula = residuals ~ fitted)
linealidad |> summary()
Call:
lm(formula = residuals ~ fitted, data = tibble(fitted = modelo$fitted.values,
residuals = modelo$residuals))
Residuals:
Min 1Q Median 3Q Max
-16.448 -4.576 -1.082 2.076 30.842
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 9.155e-15 2.918e+00 0 1
fitted -4.900e-17 1.558e-02 0 1
Residual standard error: 7.906 on 133 degrees of freedom
Multiple R-squared: 5.452e-32, Adjusted R-squared: -0.007519
F-statistic: 7.251e-30 on 1 and 133 DF, p-value: 1
ggplot(tibble("fitted" = modelo$fitted.values,
"residuals" = modelo$residuals),
aes(x = fitted, y = residuals)) +
geom_point(size = 3, alpha = 0.7) +
geom_smooth(se = FALSE) +
theme_minimal()`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
Ejercicio ___: regresión lineal término cuadrático
En caso de que no se cumpla alguna de las hipótesis del modelo considera meter en el modelo la variable IMC con su término cuadrático. Resuelve los problemas de colinealidad y repite la diagnosis del modelo.
modelo <- lm(colesterol ~ edad + consumo_grasas + tabaquismo +
antecedentes + I(imc^2), data = datos_modelo)
summary(modelo)
Call:
lm(formula = colesterol ~ edad + consumo_grasas + tabaquismo +
antecedentes + I(imc^2), data = datos_modelo)
Residuals:
Min 1Q Median 3Q Max
-24.2572 -3.7162 -0.6679 2.3481 29.2630
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 13.29055 2.96948 4.476 1.66e-05 ***
edad 0.51822 0.03224 16.074 < 2e-16 ***
consumo_grasasBajo -7.52460 1.88125 -4.000 0.000107 ***
consumo_grasasModerado -3.08706 1.64522 -1.876 0.062881 .
tabaquismoSí 5.39123 1.45310 3.710 0.000308 ***
antecedentesSí 5.18235 1.54983 3.344 0.001084 **
I(imc^2) 0.19674 0.00278 70.759 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 6.796 on 128 degrees of freedom
Multiple R-squared: 0.9778, Adjusted R-squared: 0.9767
F-statistic: 938.1 on 6 and 128 DF, p-value: < 2.2e-16
performance::check_model(modelo)performance::check_heteroscedasticity(modelo)OK: Error variance appears to be homoscedastic (p = 0.060).
olsrr::ols_test_normality(modelo)-----------------------------------------------
Test Statistic pvalue
-----------------------------------------------
Shapiro-Wilk 0.898 0.0000
Kolmogorov-Smirnov 0.1285 0.0232
Cramer-von Mises 10.4946 0.0000
Anderson-Darling 3.2116 0.0000
-----------------------------------------------
performance::check_autocorrelation(modelo)OK: Residuals appear to be independent and not autocorrelated (p = 0.942).
Ejercicio ___: regresión lineal interpretación del modelo
Interpreta los parámetros del modelo final
Ejercicio ___: regresión lineal evaluación del ajuste
Evalúa el modelo tanto gráfica como numéricamente y comenta lo que obtengas.
graf <- ggplot(tibble("y" = modelo$model$colesterol, "y_est" = modelo$fitted.values),
aes(x = y, y = y_est)) +
geom_point(size = 1.2, alpha = 0.75) +
geom_smooth(method = "lm", se = FALSE) +
theme_minimal() +
labs(x = "Valores reales", y = "Valores estimados")
plotly::ggplotly(graf)`geom_smooth()` using formula = 'y ~ x'
Ejercicio ___: regresión lineal predicción
Realiza la predicción para la observaciones que tenían valores missing en colesterol
predict(modelo, prediccion |> select(-colesterol)) 1 2 3 4 5 6 7 8
180.4778 143.4628 183.0950 147.1049 175.7378 207.5981 138.2956 155.3837
9 10 11 12
132.9818 195.2026 147.6446 166.0806
Ejercicio ___: filtrado aleatorio de observaciones
En los próximos apartados vamos a visualizar si el modelo lo realizamos con menos observaciones. Para ello busca como se emplea y utiliza la función
slice_sample()de la libreríadplyry selecciona una muestra aleatoria de tu base de datos original (sin imputar valores en caso de que lo hicieses) de 35 individuos eliminando previamente las observaciones con valores ausentes
colesterol_35 <-
colesterol |>
drop_na() |>
slice_sample(n = 35)Ejercicio ___: comprobar como cambian los p-valores de las variables
Realiza de nuevo un modelo saturado (incluyendo el IMC con su término cuadrático), resuelve los problemas de colinealidad y selecciona las variables significativas.
modelo <- lm(colesterol ~ . + I(imc^2), data = colesterol_35)
MASS::stepAIC(modelo)Start: AIC=81.2
colesterol ~ edad + nivel_actividad + estatura + peso + consumo_grasas +
tabaquismo + sexo + antecedentes + presion_sistolica + presion_diastolica +
glucosa + imc + I(imc^2)
Df Sum of Sq RSS AIC
- glucosa 1 0.89 143.62 79.413
- estatura 1 6.08 148.81 80.656
- peso 1 6.27 149.00 80.700
- imc 1 7.07 149.80 80.889
<none> 142.73 81.195
- consumo_grasas 2 27.20 169.93 83.301
- presion_sistolica 1 19.50 162.22 83.677
- sexo 1 28.53 171.26 85.574
- nivel_actividad 2 39.62 182.35 85.771
- presion_diastolica 1 30.23 172.96 85.920
- antecedentes 1 79.79 222.52 94.738
- tabaquismo 1 96.12 238.85 97.217
- I(imc^2) 1 102.11 244.83 98.083
- edad 1 1424.02 1566.75 163.049
Step: AIC=79.41
colesterol ~ edad + nivel_actividad + estatura + peso + consumo_grasas +
tabaquismo + sexo + antecedentes + presion_sistolica + presion_diastolica +
imc + I(imc^2)
Df Sum of Sq RSS AIC
- peso 1 7.71 151.33 79.244
- estatura 1 7.78 151.40 79.259
<none> 143.62 79.413
- imc 1 9.26 152.88 79.601
- consumo_grasas 2 26.68 170.30 81.377
- presion_sistolica 1 18.76 162.38 81.710
- sexo 1 27.68 171.29 83.581
- presion_diastolica 1 29.41 173.02 83.932
- nivel_actividad 2 39.83 183.44 83.979
- tabaquismo 1 96.32 239.93 95.375
- antecedentes 1 105.59 249.21 96.703
- I(imc^2) 1 106.02 249.64 96.764
- edad 1 1425.49 1569.11 161.102
Step: AIC=79.24
colesterol ~ edad + nivel_actividad + estatura + consumo_grasas +
tabaquismo + sexo + antecedentes + presion_sistolica + presion_diastolica +
imc + I(imc^2)
Df Sum of Sq RSS AIC
- estatura 1 0.07 151.40 77.259
- imc 1 1.58 152.91 77.607
<none> 151.33 79.244
- presion_sistolica 1 17.52 168.85 81.078
- consumo_grasas 2 32.56 183.89 82.064
- nivel_actividad 2 33.91 185.25 82.322
- sexo 1 25.21 176.54 82.637
- presion_diastolica 1 31.47 182.80 83.856
- antecedentes 1 97.96 249.29 94.714
- tabaquismo 1 112.26 263.59 96.667
- I(imc^2) 1 249.69 401.02 111.353
- edad 1 1472.58 1623.91 160.303
Step: AIC=77.26
colesterol ~ edad + nivel_actividad + consumo_grasas + tabaquismo +
sexo + antecedentes + presion_sistolica + presion_diastolica +
imc + I(imc^2)
Df Sum of Sq RSS AIC
- imc 1 1.53 152.93 75.611
<none> 151.40 77.259
- presion_sistolica 1 18.45 169.85 79.284
- consumo_grasas 2 32.74 184.13 80.111
- nivel_actividad 2 34.41 185.80 80.427
- sexo 1 25.15 176.54 80.638
- presion_diastolica 1 31.60 182.99 81.894
- antecedentes 1 97.89 249.29 92.715
- tabaquismo 1 112.82 264.21 94.749
- I(imc^2) 1 253.64 405.04 109.702
- edad 1 1661.61 1813.00 162.159
Step: AIC=75.61
colesterol ~ edad + nivel_actividad + consumo_grasas + tabaquismo +
sexo + antecedentes + presion_sistolica + presion_diastolica +
I(imc^2)
Df Sum of Sq RSS AIC
<none> 152.9 75.611
- consumo_grasas 2 31.4 184.3 78.140
- presion_sistolica 1 22.5 175.4 78.420
- nivel_actividad 2 35.3 188.3 78.889
- sexo 1 26.3 179.3 79.175
- presion_diastolica 1 35.2 188.2 80.866
- antecedentes 1 96.7 249.6 90.756
- tabaquismo 1 127.7 280.6 94.855
- edad 1 1672.6 1825.5 160.399
- I(imc^2) 1 27458.5 27611.4 255.472
Call:
lm(formula = colesterol ~ edad + nivel_actividad + consumo_grasas +
tabaquismo + sexo + antecedentes + presion_sistolica + presion_diastolica +
I(imc^2), data = colesterol_35)
Coefficients:
(Intercept) edad nivel_actividad.L nivel_actividad.Q
6.0231 0.4887 -2.4384 -2.2496
consumo_grasas.L consumo_grasas.Q tabaquismoSí sexoMujer
1.7182 1.5222 5.3436 2.1122
antecedentesSí presion_sistolica presion_diastolica I(imc^2)
5.9752 0.1013 -0.1786 0.2049
Ejercicio ___: regresión lineal diagnosis modelo
Realiza la diagnosis del modelo
performance::check_model(modelo)performance::check_heteroscedasticity(modelo)OK: Error variance appears to be homoscedastic (p = 0.215).
olsrr::ols_test_normality(modelo)-----------------------------------------------
Test Statistic pvalue
-----------------------------------------------
Shapiro-Wilk 0.9836 0.8689
Kolmogorov-Smirnov 0.0702 0.9905
Cramer-von Mises 1.9218 0.0000
Anderson-Darling 0.1824 0.9049
-----------------------------------------------
performance::check_autocorrelation(modelo)OK: Residuals appear to be independent and not autocorrelated (p = 0.982).
Ejercicio ___: conclusiones
Comenta los resultados obtenidos y las diferencias con el primer modelo.